BCI NET 2/BCI NET 2.iso/archives/programming/languages/editpat.lha/EditPat.Mod

Oberon Text | 1994-12-02 | 33.0 KB | 1,305 lines

Syntax10.Scn.Fnt
Syntax10b.Scn.Fnt
FoldElems
MODULE EditPat; (* V0.6 (C) 4 Nov 94 by Ralf Degner *)
    IMPORT
        Display, DisplayPat, Viewers, Oberon, Input, MenuViewers, TextFrames, Texts, Files, Fonts, Out;
    CONST
        Menu = "System.Close  System.Copy  System.Grow  EditPat.Draw  EditPat.Fill  EditPat.Insert  EditPat.Store ";
        ObenOffset=25;SeitenOffset=10;
        OO=ObenOffset;SO=SeitenOffset;
        MaxKasten=50;
        DrawMode=1; FillMode=2; InsertMode=3;
        MaxColors=256;MaxAuf=2048;
    TYPE
        SetArrayType = POINTER TO ARRAY OF SET;
        FeldType = POINTER TO ARRAY OF ARRAY OF INTEGER;
        PatData = POINTER TO PatDataDesc;
        PatDataDesc = RECORD
            NextData: PatData;
            Color: INTEGER;
            SetData: SetArrayType;
        END;
        Pat = POINTER TO PatDesc;
        PatDesc = RECORD(PatDataDesc)
            Next, Last: Pat;
            W, H: INTEGER;
        END;
        Data = POINTER TO DataDesc;
        DataDesc = RECORD
            ActivPat, LastKilled: Pat;
            XAuf, YAuf: INTEGER;
            Color, DrawMode: INTEGER;
            Feld: FeldType;
            Undo: FeldType;
            Name: ARRAY 128 OF CHAR;
            Marked: BOOLEAN;
            MText: Texts.Text;
        END;
        Frame = POINTER TO FrameDesc;
        FrameDesc = RECORD(Display.FrameDesc)
            d: Data;
            KG: INTEGER;
            LastModMsg: BOOLEAN;
            Grid, GridType: BOOLEAN;
        END;
        EditPatMsg = RECORD(Display.FrameMsg)
            d: Data;
        END;
        PlotAllMsg = RECORD(EditPatMsg)
        END;
        PlotKastenMsg = RECORD(EditPatMsg)
            X, Y: INTEGER;
        END;
        DrawModeMsg = RECORD(EditPatMsg)
        END;
        Clip: POINTER TO ARRAY OF ARRAY OF INTEGER;
        ClipW, ClipH: INTEGER;
        W: Texts.Writer;
        F: Fonts.Font;
    (* set ! to menu of frame *)
    PROCEDURE MarkData(f: Frame);
    BEGIN
        IF ~f.d.Marked THEN
            f.d.Marked:=TRUE;
            Texts.Write(W, "!");
            Texts.Append(f.d.MText, W.buf);
        END;
    END MarkData;
    (* clear edit-field *)
    PROCEDURE ClearFeld(d: Data; Color: INTEGER);
        VAR
            DumX, DumY: INTEGER;
    BEGIN
        FOR DumX:=0 TO d.XAuf-1 DO
            FOR DumY:=0 TO d.YAuf-1 DO
                d.Feld[DumX, DumY]:=Color;
            END;
        END;
    END ClearFeld;
    (* insert new pattern *)
    PROCEDURE NewPat(d: Data; W, H: INTEGER);
        VAR NPat: Pat;
    BEGIN
        NEW(NPat);
        NPat.W:=W;NPat.H:=H;
        NPat.NextData:=NIL;
        IF d.ActivPat=NIL THEN
            NPat.Next:=NIL;
            NPat.Last:=NIL;
        ELSE;
            IF d.ActivPat.Next#NIL THEN
                d.ActivPat.Next.Last:=NPat;
            END;
            NPat.Next:=d.ActivPat.Next;
            NPat.Last:=d.ActivPat;
            d.ActivPat.Next:=NPat;
        END;
        d.ActivPat:=NPat;
    END NewPat;
    (* search first pattern *)
    PROCEDURE FirstPat(FirstPat: Pat): Pat;
    BEGIN
        IF FirstPat=NIL THEN RETURN NIL;END;
        WHILE FirstPat.Last#NIL DO
            FirstPat:=FirstPat.Last;
        END;
        RETURN FirstPat;
    END FirstPat;
    (* search the last pattern *)
    PROCEDURE TheLastPat(LastPat: Pat): Pat;
    BEGIN
        IF LastPat=NIL THEN RETURN NIL;END;
        WHILE LastPat.Next#NIL DO
            LastPat:=LastPat.Next;
        END;
        RETURN LastPat;
    END TheLastPat;
    (* count number of patterns *)
    PROCEDURE CountPat(APat: Pat): LONGINT;
        VAR Anz: LONGINT;
    BEGIN
        Anz:=0;
        WHILE APat#NIL DO
            INC(Anz);
            APat:=APat.Next;
        END;
        RETURN Anz;
    END CountPat;
    (* Get Number of ActivPat *)
    PROCEDURE GetNumber(NPat: Pat): LONGINT;
        VAR Anz: LONGINT;
    BEGIN
        Anz:=0;
        WHILE NPat.Last#NIL DO
            INC(Anz);
            NPat:=NPat.Last;
        END;
        RETURN Anz;
    END GetNumber;
    (* store one Display.Pattern to memory *)
    PROCEDURE OnePatToMem(d: Data; Color: INTEGER; LastData: PatData; XPos: INTEGER): PatData;
        VAR
            NewData: PatData;
            SetData: SetArrayType;
            DumX, DumY: INTEGER;
            OneSet: SET;
    BEGIN
        NEW(NewData);
        NewData.NextData:=NIL;
        LastData.NextData:=NewData;
        NEW(SetData, d.YAuf);
        NewData.SetData:=SetData;
        NewData.Color:=Color;
        FOR DumY:=0 TO d.YAuf-1 DO
            OneSet:={};
            DumX:=0;
            REPEAT
                IF d.Feld[DumX+XPos, DumY]=Color THEN
                    INCL(OneSet, DumX);
                END;
                INC(DumX);
            UNTIL (DumX=32) OR (DumX+XPos=d.XAuf);
            SetData^[DumY]:=OneSet;
        END;
        RETURN NewData;
    END OnePatToMem;
    (* store pattern from display to memory *)
    PROCEDURE StoreToMem(d: Data);
        VAR
            ColorMap: ARRAY MaxColors OF BOOLEAN;
            LastData: PatData;
            DumX, DumY: INTEGER;
    BEGIN
        IF d.ActivPat=NIL THEN RETURN;END;
        FOR DumX:=0 TO MaxColors-1 DO
            ColorMap[DumX]:=FALSE;
        END;
        FOR DumX:=0 TO d.XAuf-1 DO
            FOR DumY:=0 TO d.YAuf-1 DO
                ColorMap[d.Feld[DumX, DumY]]:=TRUE;
            END;
        END;
        LastData:=d.ActivPat;
        FOR DumX:=1 TO MaxColors-1 DO
            IF ColorMap[DumX] THEN
                DumY:=0;
                REPEAT
                    LastData:=OnePatToMem(d, DumX, LastData, DumY);
                    INC(DumY, 32);
                UNTIL DumY>d.XAuf;
            END;
        END;
        LastData.NextData:=NIL;
    END StoreToMem;
    (* put pattern from memory to field *)
    PROCEDURE PatToFeld(d: Data);
        VAR
            DumX, DumY, Count, Color: INTEGER;
            NewFeld: FeldType;
            UsedPData: PatData;
            OneSet: SET;
    BEGIN
        IF d.ActivPat=NIL THEN RETURN;END;
        d.XAuf:=d.ActivPat.W;
        d.YAuf:=d.ActivPat.H;
        NEW(NewFeld, d.XAuf, d.YAuf);
        d.Feld:=NewFeld;
        ClearFeld(d, Display.black);
        UsedPData:=d.ActivPat;
        Color:=Display.black;
        WHILE (UsedPData.NextData#NIL) DO
            UsedPData:=UsedPData.NextData;
            IF UsedPData.Color#Color THEN
                Color:=UsedPData.Color;
                Count:=0;
            END;
            FOR DumY:=0 TO d.YAuf-1 DO
                OneSet:=UsedPData.SetData[DumY];
                FOR DumX:=0 TO 31 DO
                    IF DumX IN OneSet THEN
                        NewFeld[DumX+Count, DumY]:=Color;
                    END;
                END;
            END;
            INC(Count, 32);
        END;
    END PatToFeld;
    (* get selected frame *)
    PROCEDURE GetFrame(VAR f: Display.Frame): BOOLEAN;
        VAR v: Viewers.Viewer;
    BEGIN
        IF Oberon.Par.frame=Oberon.Par.vwr.dsc THEN
            IF (Oberon.Par.frame # NIL) THEN
                f:=Oberon.Par.frame.next;
                RETURN TRUE;
            END;
        ELSE
            v:=Oberon.MarkedViewer();
            IF (v.dsc # NIL) & (v.dsc.next # NIL) THEN
                f:=v.dsc.next;
                RETURN TRUE;
            END
        END;
        RETURN FALSE;
    END GetFrame;
    (* get parameters from Menu, Text or Selection *)
    PROCEDURE GetPar(VAR S: Texts.Scanner): BOOLEAN;
        VAR
            text: Texts.Text;
            beg, end, time: LONGINT;
    BEGIN
        Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
        Texts.Scan(S);
        IF S.class=Texts.Char THEN
            IF S.c="^" THEN
                Oberon.GetSelection(text, beg, end, time);
                IF time=-1 THEN RETURN FALSE; END;
                Texts.OpenScanner(S, text, beg);
                Texts.Scan(S);
            END;
        END;
        RETURN TRUE;
    END GetPar;
    (* changes the drawing color *)
    PROCEDURE ChangeColor*;
        VAR
            S: Texts.Scanner;
            f, g: Display.Frame;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF GetPar(S) THEN
                    IF S.class=Texts.Int THEN
                        IF (S.i>=0) & (S.i<MaxColors) THEN
                            f.d.Color:=SHORT(S.i);
                        END;
                    END;
                END;
            ELSE
            END;
        END;
    END ChangeColor;
    (* changes mode to DRAW *)
    PROCEDURE Draw*;
        VAR
            S: Texts.Scanner;
            f, g: Display.Frame;
            dmmsg: DrawModeMsg;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF f.d.DrawMode#DrawMode THEN
                    f.d.DrawMode:=DrawMode;
                    dmmsg.d:=f.d;
                    Viewers.Broadcast(dmmsg);
                END;
            ELSE
            END;
        END;
    END Draw;
    (* changes mode to FILL *)
    PROCEDURE Fill*;
        VAR
            S: Texts.Scanner;
            f, g: Display.Frame;
            dmmsg: DrawModeMsg;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF f.d.DrawMode#FillMode THEN
                    f.d.DrawMode:=FillMode;
                    dmmsg.d:=f.d;
                    Viewers.Broadcast(dmmsg);
                END;
            ELSE
            END;
        END;
    END Fill;
    (* changes mode to INSERT *)
    PROCEDURE Insert*;
        VAR
            S: Texts.Scanner;
            f, g: Display.Frame;
            dmmsg: DrawModeMsg;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF f.d.DrawMode#InsertMode THEN
                    f.d.DrawMode:=InsertMode;
                    dmmsg.d:=f.d;
                    Viewers.Broadcast(dmmsg);
                END;
            ELSE
            END;
        END;
    END Insert;
    (* show previous Pat *)
    PROCEDURE Prev*;
        VAR
            pamsg: PlotAllMsg;
            f, g: Display.Frame;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF f.d.ActivPat#NIL THEN
                    IF f.d.ActivPat.Last#NIL THEN
                        pamsg.d:=f.d;
                        StoreToMem(f.d);
                        f.d.ActivPat:=f.d.ActivPat.Last;
                        PatToFeld(f.d);
                        Viewers.Broadcast(pamsg);
                    END;
                END;
            ELSE
            END;
        END;
    END Prev;
    (* show next Pat *)
    PROCEDURE Next*;
        VAR
            pamsg: PlotAllMsg;
            f, g: Display.Frame;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF f.d.ActivPat#NIL THEN
                    IF f.d.ActivPat.Next#NIL THEN
                        pamsg.d:=f.d;
                        StoreToMem(f.d);
                        f.d.ActivPat:=f.d.ActivPat.Next;
                        PatToFeld(f.d);
                        Viewers.Broadcast(pamsg);
                    END;
                END;
            ELSE
            END;
        END;
    END Next;
    (* show first pat *)
    PROCEDURE First*;
        VAR
            pamsg: PlotAllMsg;
            f, g: Display.Frame;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF f.d.ActivPat#NIL THEN
                    IF f.d.ActivPat.Last#NIL THEN
                        pamsg.d:=f.d;
                        StoreToMem(f.d);
                        f.d.ActivPat:=FirstPat(f.d.ActivPat);
                        PatToFeld(f.d);
                        Viewers.Broadcast(pamsg);
                    END;
                END;
            ELSE
            END;
        END;
    END First;
    (* show the last pat *)
    PROCEDURE Last*;
        VAR
            pamsg: PlotAllMsg;
            f, g: Display.Frame;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF f.d.ActivPat#NIL THEN
                    IF f.d.ActivPat.Next#NIL THEN
                        pamsg.d:=f.d;
                        StoreToMem(f.d);
                        f.d.ActivPat:=TheLastPat(f.d.ActivPat);
                        PatToFeld(f.d);
                        Viewers.Broadcast(pamsg);
                    END;
                END;
            ELSE
            END;
        END;
    END Last;
    (* zoom in or out *)
    PROCEDURE Goto*;
        VAR
            pamsg: PlotAllMsg;
            S: Texts.Scanner;
            f, g: Display.Frame;
            Dummy: LONGINT;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF GetPar(S) THEN
                    IF S.class=Texts.Int THEN
                        Dummy:=CountPat(f.d.ActivPat);
                        IF (S.i>=0) & (S.i<Dummy) THEN
                            Dummy:=S.i;
                            pamsg.d:=f.d;
                            StoreToMem(f.d);
                            f.d.ActivPat:=FirstPat(f.d.ActivPat);
                            WHILE Dummy#0 DO
                                DEC(Dummy);
                                f.d.ActivPat:=f.d.ActivPat.Next;
                            END;
                            PatToFeld(f.d);
                            Viewers.Broadcast(pamsg);
                        END;
                    END;
                END;
            ELSE
            END;
        END;
    END Goto;
    (* zoom in or out *)
    PROCEDURE Zoom*;
        VAR
            pamsg: PlotAllMsg;
            S: Texts.Scanner;
            f, g: Display.Frame;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF GetPar(S) THEN
                    pamsg.d:=f.d;
                    IF S.class=Texts.Char THEN
                        IF S.c="+" THEN
                            IF f.KG<MaxKasten THEN
                                INC(f.KG);
                                f.handle(f, pamsg);
                            END;
                        ELSIF S.c="-" THEN
                            IF f.KG>1 THEN
                                DEC(f.KG);
                                f.handle(f, pamsg);
                            END;
                        END;
                    ELSIF S.class=Texts.Int THEN
                        IF (S.i>0) & (S.i<=MaxKasten) THEN
                            f.KG:=SHORT(S.i);
                            f.handle(f, pamsg);
                        END;
                    END;
                END;
            ELSE
            END;
        END;
    END Zoom;
    (* pattern coordinates to frame coordinates *)
    PROCEDURE KastenToFrame(f: Frame; XK, YK: INTEGER; VAR XF, YF: INTEGER);
        VAR XWert, YWert, Dum: INTEGER;
    BEGIN
        IF f.Grid THEN
            XWert:=1;
        ELSE
            XWert:=0;
        END;
        Dum:=f.KG+XWert;
        XWert:=f.X+SeitenOffset+XWert;
        YWert:=f.Y+f.H-ObenOffset-f.d.YAuf*Dum;
        XF:=XWert+XK*Dum;
        YF:=YWert+YK*Dum;
    END KastenToFrame;
    (* frame coordinates to pattern coordinates *)
    PROCEDURE FrameToKasten(f: Frame; XF, YF: INTEGER; VAR XK, YK: INTEGER): BOOLEAN;
        VAR Dum, DumX, DumY: INTEGER;
    BEGIN
        IF f.Grid THEN
            Dum:=f.KG+1;
        ELSE
            Dum:=f.KG;
        END;
        DumX:=(XF-SO-f.X);
        DumY:=(YF+OO+f.d.YAuf*Dum-f.H-f.Y);
        IF f.Grid THEN
            IF ((DumX MOD Dum)=0) OR ((DumY MOD Dum)=0) THEN RETURN FALSE;END;
            XK:=DumX DIV Dum;YK:=DumY DIV Dum;
        ELSE
            XK:=DumX DIV f.KG;YK:=DumY DIV f.KG;
        END;
        IF (XK<0) OR (YK<0) OR (XK>=f.d.XAuf) OR (YK>=f.d.YAuf) THEN RETURN FALSE;END;
        RETURN TRUE;
    END FrameToKasten;
    (* plot whole field at frame *)
    PROCEDURE PlotFeld(f: Frame);
        VAR
            DX, DY, Dum: INTEGER;
            XWert, YWert: INTEGER;
    BEGIN
        IF f.Grid THEN
            XWert:=1;
        ELSE
            XWert:=0;
        END;
        Dum:=f.KG+XWert;
        DX:=(Dum)*f.d.XAuf+2-XWert;
        DY:=(Dum)*f.d.YAuf+2-XWert;
        IF f.GridType THEN
            Display.ReplConstC(f, Display.white, f.X+SO-1+XWert, f.Y+f.H-OO-DY+1-XWert, DX, DY, Display.replace);
        ELSE
            Display.ReplPatternC(f, Display.white, Display.grey1, f.X+SO-1+XWert, f.Y+f.H-OO-DY+1-XWert, DX, DY, 0, 0, Display.replace);
        END;
        XWert:=f.X+SeitenOffset+XWert;
        YWert:=f.Y+f.H-ObenOffset-f.d.YAuf*Dum;
        FOR DX:=0 TO f.d.XAuf-1 DO
            FOR DY:=0 TO f.d.YAuf-1 DO
                Display.ReplConstC(f, f.d.Feld[DX, DY], XWert+DX*Dum, YWert+DY*Dum, f.KG, f.KG, Display.replace);
            END;
        END;
    END PlotFeld;
    (* plot one pixel to frame *)
    PROCEDURE PlotKasten(f: Frame; X, Y: INTEGER);
        VAR XPos, YPos: INTEGER;
    BEGIN
        KastenToFrame(f, X, Y, XPos, YPos);
        Oberon.RemoveMarks(XPos, YPos, f.KG, f.KG);
        Display.ReplConstC(f, f.d.Feld[X, Y], XPos, YPos, f.KG, f.KG, Display.replace);
    END PlotKasten;
    (* plot Mode *)
    PROCEDURE PlotMode(f: Frame);
    BEGIN
        Display.ReplConstC(f, Display.black, f.X+SO, f.Y+f.H-OO+1, f.X+SO+49, f.Y+f.H, Display.replace);
        IF f.d.DrawMode=DrawMode THEN
            Texts.WriteString(W, "DRAW");
        ELSIF f.d.DrawMode=FillMode THEN
            Texts.WriteString(W, "FILL");
        ELSIF f.d.DrawMode=InsertMode THEN
            Texts.WriteString(W, "INSERT");
        END;
        DisplayPat.PlotText(f, Display.white, F, W.buf, f.X+SO, f.Y+f.H-17, Display.paint);
    END PlotMode;
    (* plot all new *)
    PROCEDURE PlotAll(f: Frame);
    BEGIN
        Oberon.RemoveMarks(f.X, f.Y, f.W, f.H);
        Display.ReplConst(Display.black, f.X, f.Y, f.W, f.H, Display.replace);
        IF f.d.ActivPat#NIL THEN
            Texts.WriteString(W, "Pattern Number: ");
            Texts.WriteInt(W, GetNumber(f.d.ActivPat), 1);
            Texts.Write(W, "/");
            Texts.WriteInt(W, CountPat(FirstPat(f.d.ActivPat)), 1);
            Texts.WriteString(W, "   Height: ");
            Texts.WriteInt(W, f.d.XAuf, 1);
            Texts.WriteString(W, "   Width: ");
            Texts.WriteInt(W, f.d.YAuf, 1);
            Texts.WriteString(W, "   Zoom: ");
            Texts.WriteInt(W, f.KG, 1);
            DisplayPat.PlotText(f, Display.white, F, W.buf, f.X+SO+60, f.Y+f.H-17, Display.paint);
            PlotMode(f);
            PlotFeld(f);
        END;
    END PlotAll;
    (* clear current pattern *)
    PROCEDURE Clear*;
        VAR
            pamsg: PlotAllMsg;
            f, g: Display.Frame;
            S: Texts.Scanner;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF GetPar(S) & (f.d.Feld#NIL) THEN
                    IF S.class=Texts.Int THEN
                        IF (S.i<0) OR (S.i>255) THEN RETURN;END;
                        ClearFeld(f.d, SHORT(S.i));
                    ELSE
                        ClearFeld(f.d, Display.black);
                    END;
                    pamsg.d:=f.d;
                    Viewers.Broadcast(pamsg);
                    MarkData(f);
                END;
            ELSE
            END;
        END;
    END Clear;
    (* plot one pixel, specified by coordinates *)
    PROCEDURE Plot*;
        VAR
            pkmsg: PlotKastenMsg;
            f, g: Display.Frame;
            X, Y, Color: INTEGER;
            S: Texts.Scanner;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF GetPar(S) & (f.d.Feld#NIL) THEN
                    IF S.class=Texts.Int THEN
                        X:=SHORT(S.i);
                        Texts.Scan(S);
                        IF S.class=Texts.Int THEN
                            Y:=SHORT(S.i);
                            IF (X>=0) & (Y>=0) & (X<f.d.XAuf) & (Y<f.d.YAuf) THEN
                                Texts.Scan(S);
                                IF S.class=Texts.Int THEN
                                    IF (S.i<0) OR (S.i>=MaxColors) THEN RETURN;END;
                                    Color:=SHORT(S.i);
                                ELSE
                                    Color:=f.d.Color;
                                END;
                                f.d.Feld[X ,Y]:=Color;
                                pkmsg.X:=X;pkmsg.Y:=Y;
                                pkmsg.d:=f.d;
                                Viewers.Broadcast(pkmsg);
                            END;
                        END;
                    END;
                END;
            ELSE
            END;
        END;
    END Plot;
    (* insert new pattern *)
    PROCEDURE New*;
        VAR
            pamsg: PlotAllMsg;
            f, g: Display.Frame;
            X, Y: INTEGER;
            S: Texts.Scanner;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF GetPar(S) THEN
                    IF S.class=Texts.Int THEN
                        X:=SHORT(S.i);
                        Texts.Scan(S);
                        IF S.class=Texts.Int THEN
                            Y:=SHORT(S.i);
                            IF (X>=0) & (Y>=0) & (X<MaxAuf) & (Y<MaxAuf) THEN
                                StoreToMem(f.d);
                                NewPat(f.d, X, Y);
                                f.d.XAuf:=X;f.d.YAuf:=Y;
                                f.d.Feld:=NIL;
                                NEW(f.d.Feld, X, Y);
                                ClearFeld(f.d, Display.black);
                                pamsg.d:=f.d;
                                Viewers.Broadcast(pamsg);
                                MarkData(f);
                            END;
                        END;
                    END;
                END;
            ELSE
            END;
        END;
    END New;
    (* delete activ pattern *)
    PROCEDURE Delete*;
        VAR
            pamsg: PlotAllMsg;
            f, g: Display.Frame;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF f.d.ActivPat#NIL THEN
                    f.d.LastKilled:=f.d.ActivPat;
                    IF f.d.ActivPat.Next=NIL THEN
                        IF f.d.ActivPat.Last=NIL THEN
                            f.d.ActivPat:=NIL;
                        ELSE
                            f.d.ActivPat:=f.d.ActivPat.Last;
                            f.d.ActivPat.Next:=NIL;
                        END;
                    ELSE
                        f.d.ActivPat:=f.d.ActivPat.Next;
                        IF f.d.LastKilled.Last=NIL THEN
                            f.d.ActivPat.Last:=NIL;
                        ELSE
                            f.d.ActivPat.Last:=f.d.LastKilled.Last;
                            f.d.LastKilled.Last.Next:=f.d.ActivPat;
                        END;
                    END;
                    f.d.LastKilled.Next:=NIL;
                    f.d.LastKilled.Last:=NIL;
                    pamsg.d:=f.d;
                    PatToFeld(f.d);
                    Viewers.Broadcast(pamsg);
                    MarkData(f);
                END;
            ELSE
            END;
        END;
    END Delete;
    (* replot patterns from memory *)
    PROCEDURE Recall*;
        VAR
            f, g: Display.Frame;
            pamsg: PlotAllMsg;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF f.d.LastKilled#NIL THEN
                    IF f.d.ActivPat#NIL THEN
                        IF f.d.ActivPat.Next#NIL THEN
                            f.d.ActivPat.Next.Last:=f.d.LastKilled;
                        END;
                        f.d.LastKilled.Next:=f.d.ActivPat.Next;
                        f.d.LastKilled.Last:=f.d.ActivPat;
                        f.d.ActivPat.Next:=f.d.LastKilled;
                    END;
                    f.d.ActivPat:=f.d.LastKilled;
                    PatToFeld(f.d);
                    pamsg.d:=f.d;
                    Viewers.Broadcast(pamsg);
                    f.d.LastKilled:=NIL;
                    MarkData(f);
                END;
            ELSE
            END;
        END;
    END Recall;
    (* replot patterns from memory *)
    PROCEDURE Undo*;
        VAR
            f, g: Display.Frame;
            pamsg: PlotAllMsg;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF (f.d.ActivPat#NIL) & f.d.Marked THEN
                    PatToFeld(f.d);
                    pamsg.d:=f.d;
                    Viewers.Broadcast(pamsg);
                    MarkData(f);
                END;
            ELSE
            END;
        END;
    END Undo;
    (* duplicate activ pattern *)
    PROCEDURE Duplicate*;
        VAR
            f, g: Display.Frame;
            pamsg: PlotAllMsg;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                IF f.d.ActivPat#NIL THEN
                    StoreToMem(f.d);
                    NewPat(f.d, f.d.ActivPat.W, f.d.ActivPat.H);
                    StoreToMem(f.d);
                    pamsg.d:=f.d;
                    Viewers.Broadcast(pamsg);
                    MarkData(f);
                END;
            ELSE
            END;
        END;
    END Duplicate;
    (* switch grid on/off *)
    PROCEDURE Grid*;
        VAR
            f, g: Display.Frame;
            pamsg: PlotAllMsg;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                f.Grid:=~f.Grid;
                pamsg.d:=f.d;
                f.handle(f, pamsg);
            ELSE
            END;
        END;
    END Grid;
    (* switch grid mode *)
    PROCEDURE GridMode*;
        VAR
            f, g: Display.Frame;
            pamsg: PlotAllMsg;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                f.GridType:=~f.GridType;
                pamsg.d:=f.d;
                f.handle(f, pamsg);
            ELSE
            END;
        END;
    END GridMode;
    (* copy frame *)
    PROCEDURE CopyMe(f: Frame): Frame;
        VAR nf: Frame;
    BEGIN
        NEW(nf);IF nf=NIL THEN RETURN NIL;END;
        nf.handle:=f.handle;
        nf.d:=f.d;nf.KG:=f.KG;
        nf.Grid:=f.Grid;nf.GridType:=f.GridType;
        nf.LastModMsg:=TRUE;
        RETURN nf;
    END CopyMe;
    (* store all data to file *)
    PROCEDURE StorePat(d: Data; Name: ARRAY OF CHAR): LONGINT;
        VAR
            File: Files.File;
            Rider: Files.Rider;
            PatDum: Pat;
            PatDataDum: PatData;
            PatAnz, BytesAnz: LONGINT;
            XCount: INTEGER;
    BEGIN
        BytesAnz:=0;
        File:=Files.New(Name);
        Files.Set(Rider, File, 0);
        Files.WriteLInt(Rider, 26021970);
        PatDum:=FirstPat(d.ActivPat);
        PatAnz:=CountPat(PatDum);
        Files.WriteLInt(Rider, PatAnz);
        WHILE PatAnz#0 DO
            Files.WriteInt(Rider, PatDum.W);Files.WriteInt(Rider, PatDum.H);
            PatDataDum:=PatDum;
            WHILE PatDataDum.NextData#NIL DO
                INC(BytesAnz, 1);
                PatDataDum:=PatDataDum.NextData;
                Files.WriteInt(Rider, PatDataDum.Color);
                FOR XCount:=0 TO PatDum.H-1 DO
                    DisplayPat.WriteSet(Rider, PatDataDum.SetData[XCount]);
                END;
            END;
            Files.WriteInt(Rider, -1);
            DEC(PatAnz);
            PatDum:=PatDum.Next;
        END;
        Files.Register(File);
        RETURN BytesAnz;
    END StorePat;
    (* load data from file *)
    PROCEDURE LoadPat(d: Data);
        VAR
            File: Files.File;
            Rider: Files.Rider;
            LDum, PatAnz: LONGINT;
            DataDum, LastData: PatData;
            W, H, Color, Count: INTEGER;
    BEGIN
        File:=Files.Old(d.Name);
        IF File=NIL THEN RETURN;END;
        Files.Set(Rider, File, 0);
        Files.ReadLInt(Rider, LDum);
        IF LDum#26021970 THEN RETURN;END;
        Files.ReadLInt(Rider, PatAnz);
        WHILE PatAnz#0 DO
            Files.ReadInt(Rider, W);Files.ReadInt(Rider, H);
            NewPat(d, W, H);LastData:=d.ActivPat;
            Files.ReadInt(Rider, Color);
            WHILE Color#-1 DO
                NEW(DataDum);DataDum.NextData:=NIL;
                LastData.NextData:=DataDum;
                DataDum.Color:=Color;
                NEW(DataDum.SetData, H);
                FOR Count:=0 TO H-1 DO
                    DisplayPat.ReadSet(Rider, DataDum.SetData[Count]);
                END;
                Files.ReadInt(Rider, Color);
                LastData:=DataDum;
            END;
            DEC(PatAnz);
        END;
        d.ActivPat:=FirstPat(d.ActivPat);
        PatToFeld(d);
    END LoadPat;
    (* store data to file *)
    PROCEDURE Store*;
        VAR
            S: Texts.Scanner;
            f, g: Display.Frame;
            Name, NameBak: ARRAY 256 OF CHAR;
            Counter: INTEGER;
    BEGIN
        IF GetFrame(g) THEN
            f:=g;
            WITH f: Frame DO
                COPY(f.d.Name, Name);
                IF GetPar(S) THEN
                    IF S.class=Texts.Name THEN
                        COPY(S.s, Name);
                    ELSE
                        Texts.OpenScanner(S, f.d.MText, 0);
                        Texts.Scan(S);
                        IF S.class=Texts.Name THEN
                            COPY(S.s, Name);
                        END;
                    END;
                    Texts.WriteString(W, "EditPat.Store ");
                    Texts.WriteString(W, Name);
                    Texts.Write(W, " ");
                    Texts.Append(Oberon.Log, W.buf);
                    COPY(Name, NameBak);
                    Counter:=0;
                    WHILE NameBak[Counter]#0X DO INC(Counter);END;
                    NameBak[Counter]:=".";NameBak[Counter+1]:="B";NameBak[Counter+2]:="a";
                    NameBak[Counter+3]:="k";NameBak[Counter+4]:=0X;
                    Files.Delete(NameBak, Counter);
                    Files.Rename(Name, NameBak, Counter);
                    StoreToMem(f.d);
                    Texts.WriteInt(W, StorePat(f.d, Name), 1);
                    Texts.WriteLn(W);
                    Texts.Append(Oberon.Log, W.buf);
                    IF f.d.Marked THEN
                        f.d.Marked:=FALSE;
                        Texts.Delete(f.d.MText, f.d.MText.len-1, f.d.MText.len);
                    END;
                END;
            ELSE
            END;
        END;
    END Store;
    (* handel drawing mousaction *)
    PROCEDURE DoDraw(f: Frame; X, Y: INTEGER; k:SET);
        VAR
            LastXKast, LastYKast, XKas, YKas: INTEGER;
            pkmsg: PlotKastenMsg;
            NewKeys: SET;
    BEGIN
        LastXKast:=-1;LastYKast:=-1;
        REPEAT
            Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
            IF FrameToKasten(f, X, Y, XKas, YKas) THEN
                pkmsg.d:=f.d;
                IF (LastXKast#XKas) OR (LastYKast#YKas) THEN
                    pkmsg.X:=XKas;pkmsg.Y:=YKas;
                    LastXKast:=XKas;LastYKast:=YKas;
                    IF k={2} THEN
                        f.d.Feld[XKas, YKas]:=f.d.Color;
                    ELSE
                        f.d.Feld[XKas, YKas]:=Display.black;
                    END;
                    Viewers.Broadcast(pkmsg);
                    MarkData(f);
                END;
            END;
            Input.Mouse(NewKeys, X, Y)
        UNTIL (NewKeys#k);
    END DoDraw;
    (* do filling *)
    PROCEDURE FillProc(d: Data; XKas, YKas, Color, OldColor: INTEGER);
        VAR pkmsg: PlotKastenMsg;
    BEGIN
        IF (XKas>=0) & (YKas>=0) & (XKas<d.XAuf) & (YKas<d.YAuf) THEN
            IF d.Feld[XKas, YKas]=OldColor THEN
                d.Feld[XKas, YKas]:=Color;
                pkmsg.d:=d;
                pkmsg.X:=XKas;pkmsg.Y:=YKas;
                Viewers.Broadcast(pkmsg);
                FillProc(d, XKas+1, YKas, Color, OldColor);
                FillProc(d, XKas-1, YKas, Color, OldColor);
                FillProc(d, XKas, YKas+1, Color, OldColor);
                FillProc(d, XKas, YKas-1, Color, OldColor);
            END;
        END;
    END FillProc;
    (* handel drawing mousaction *)
    PROCEDURE DoFill(f: Frame; X, Y: INTEGER; k:SET);
        VAR
            Color, XKas, YKas: INTEGER;
            NewKeys: SET;
    BEGIN
        IF k={2} THEN
            Color:=f.d.Color;
        ELSE
            Color:=Display.black;
        END;
        REPEAT
            Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
            Input.Mouse(NewKeys, X, Y);
            k:=k+NewKeys;
        UNTIL (NewKeys={});
        IF (k={0}) OR (k={2}) THEN
            IF FrameToKasten(f, X, Y, XKas, YKas) THEN
                IF Color#f.d.Feld[XKas, YKas] THEN
                    FillProc(f.d, XKas, YKas, Color, f.d.Feld[XKas, YKas]);
                    MarkData(f);
                END;
            END;
        END;
    END DoFill;
    (* invert rectangle area for copy and cut *)
    PROCEDURE InvertRec(f:Frame; X1, Y1, X2, Y2: INTEGER);
        VAR W, H, Dummy: INTEGER;
    BEGIN
        IF X1>X2 THEN
            Dummy:=X1;
            X1:=X2;X2:=Dummy;
        END;
        IF Y1>Y2 THEN
            Dummy:=Y1;
            Y1:=Y2;Y2:=Dummy;
        END;
        W:=X2-X1;H:=Y2-Y1;
        Oberon.RemoveMarks(X1, Y1, W, H);
        Display.ReplConstC(f, Display.white, X1, Y1, W, 1, Display.invert);
        Display.ReplConstC(f, Display.white, X1, Y1, 1, H, Display.invert);
        Display.ReplConstC(f, Display.white, X1, Y1+H, W, 1, Display.invert);
        Display.ReplConstC(f, Display.white, X1+W, Y1, 1, H, Display.invert);
    END InvertRec;
    (* do copy and cut *)
    PROCEDURE GetPart(f: Frame; XStart, YStart: INTEGER; k:SET);
        VAR
            Color, X, Y, XKasStart, YKasStart, XKasEnd, YKasEnd, XAlt, YAlt: INTEGER;
            NewKey: SET;
            pkmsg: PlotKastenMsg;
    BEGIN
        IF FrameToKasten(f, XStart, YStart, XKasStart, YKasStart) THEN
            XAlt:=XStart;YAlt:=YStart;
            InvertRec(f, XStart, YStart, XStart, YStart);
            Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, XStart, YStart);
            REPEAT
                Input.Mouse(NewKey, X, Y);
                k:=k+NewKey;
                IF (XAlt#X) OR (YAlt#Y) THEN
                    InvertRec(f, XAlt, YAlt, XStart, YStart);
                    XAlt:=X;YAlt:=Y;
                    InvertRec(f, X, Y, XStart, YStart);
                    Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
                END;
            UNTIL NewKey={};
            InvertRec(f, X, Y, XStart, YStart);
            IF FrameToKasten(f, X, Y, XKasEnd, YKasEnd) THEN
                IF (k={1}) OR (k={1,0}) OR (k={1,2}) THEN
                    Color:=-1;pkmsg.d:=f.d;
                    IF k={1,2} THEN
                        Color:=f.d.Color;
                    ELSIF k={0,1} THEN
                        Color:=Display.black;
                    END;
                    IF XKasStart>XKasEnd THEN
                        X:=XKasStart;
                        XKasStart:=XKasEnd;XKasEnd:=X;
                    END;
                    IF YKasStart>YKasEnd THEN
                        Y:=YKasStart;
                        YKasStart:=YKasEnd;YKasEnd:=Y;
                    END;
                    ClipW:=XKasEnd-XKasStart+1;
                    ClipH:=YKasEnd-YKasStart+1;
                    NEW(Clip, ClipW, ClipH);
                    FOR X:=0 TO ClipW-1 DO
                        FOR Y:=0 TO ClipH-1 DO
                            Clip[X, Y]:=f.d.Feld[XKasStart+X, YKasStart+Y];
                            IF Color#-1 THEN
                                f.d.Feld[XKasStart+X, YKasStart+Y]:=Color;
                                pkmsg.X:=XKasStart+X;pkmsg.Y:=YKasStart+Y;
                                Viewers.Broadcast(pkmsg);
                            END;
                        END;
                    END;
                    IF Color#-1 THEN MarkData(f);END;
                END;
            END;
        END;
    END GetPart;
    (* insert clipboard *)
    PROCEDURE DoInsert(f: Frame; X, Y: INTEGER; k:SET);
        VAR
            XCount, YCount, XKas, YKas, W, H: INTEGER;
            pkmsg: PlotKastenMsg;
            NewKeys: SET;
    BEGIN
        IF Clip#NIL THEN
            REPEAT
                Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
                Input.Mouse(NewKeys, X, Y);
                k:=k+NewKeys;
            UNTIL (NewKeys#k);
            IF ((k={0}) OR (k={2})) & FrameToKasten(f, X, Y, XKas, YKas) THEN
                IF XKas+ClipW>f.d.XAuf THEN
                    W:=f.d.XAuf-XKas;
                ELSE
                    W:=ClipW;
                END;
                IF YKas+ClipH>f.d.YAuf THEN
                    H:=f.d.YAuf-YKas;
                ELSE
                    H:=ClipH;
                END;
                pkmsg.d:=f.d;
                FOR XCount:=0 TO W-1 DO
                    FOR YCount:=0 TO H-1 DO
                        IF (k={2}) OR ~(Clip[XCount, YCount]=Display.black) THEN
                            f.d.Feld[XCount+XKas, YCount+YKas]:=Clip[XCount, YCount];;
                            pkmsg.X:=XCount+XKas;pkmsg.Y:=YCount+YKas;
                            Viewers.Broadcast(pkmsg);
                        END;
                    END;
                END;
                MarkData(f);
            END;
        END;
    END DoInsert;
    (* do mouseaction *)
    PROCEDURE TrackMouse(f: Frame; X, Y: INTEGER; k: SET);
        VAR
            XPos, YPos: INTEGER;
            NewKeys, FirstKey: SET;
            XKas, YKas: INTEGER;
    BEGIN
        IF f.d.ActivPat#NIL THEN
            IF k={1} THEN
                GetPart(f, X, Y, k);
            ELSIF f.d.DrawMode=DrawMode THEN
                IF (k={0}) OR (k={2}) THEN DoDraw(f, X, Y, k);END;
            ELSIF f.d.DrawMode=FillMode THEN
                IF (k={0}) OR (k={2}) THEN DoFill(f, X, Y, k);END;
            ELSIF f.d.DrawMode=InsertMode THEN
                IF (k={0}) OR (k={2}) THEN DoInsert(f, X, Y, k);END;
            END;
        END;
        XPos:=X;YPos:=Y;
        FirstKey:=k;
        REPEAT
            Input.Mouse(NewKeys, X, Y);
            Oberon.DrawCursor(Oberon.Mouse, Oberon.Arrow, X, Y);
            k:=k+NewKeys;
        UNTIL NewKeys={};
    END TrackMouse;
    (* the handler of the frame *)
    PROCEDURE Handler(f: Display.Frame; VAR m: Display.FrameMsg);
        VAR
            self: Frame;
            dumY, dumH: INTEGER;
    BEGIN
        self:=f(Frame);
        WITH m: Oberon.InputMsg DO
            IF m.id=Oberon.track THEN TrackMouse(self, m.X, m.Y, m.keys);END;
        | m: Oberon.CopyMsg DO
            m.F:=CopyMe(self);
        | m: MenuViewers.ModifyMsg DO
            IF m.H=0 THEN
                self.LastModMsg:=TRUE;
                RETURN;
            END;
            IF m.id=MenuViewers.extend THEN    (* extended *)
                f.Y:=m.Y;f.H:=m.H;
                PlotAll(self);
            ELSIF m.id=MenuViewers.reduce THEN    (* reduced *)
                dumY:=f.Y;dumH:=f.H;
                f.Y:=m.Y;f.H:=m.H;
                IF m.dY#0 THEN             (* if top moved, copy *)
                    Oberon.RemoveMarks(self.X, m.Y, self.W, m.H-m.dY);
                    Display.CopyBlock(self.X, dumY+dumH-m.H, self.W, m.H, self.X, m.Y, Display.replace);
                END;
            END;
            self.LastModMsg:=FALSE;
        | m: EditPatMsg DO
            IF (self.d=m.d) OR (m.d=NIL) THEN
                WITH m: PlotAllMsg DO
                    PlotAll(self);
                | m: PlotKastenMsg DO
                    PlotKasten(self, m.X, m.Y);
                | m: DrawModeMsg DO
                    PlotMode(self);
                ELSE
                END;
            END;
        ELSE
        END;
    END Handler;
    (* open new edit frame *)
    PROCEDURE CopyFrame*;
        VAR
            x, y: INTEGER;
            g, h: Display.Frame;
            f: Frame;
            tf: TextFrames.Frame;
            v: MenuViewers.Viewer;
    BEGIN
        IF GetFrame(g) THEN
            h:=g;
            WITH h: Frame DO
                NEW(f);IF f=NIL THEN RETURN;END;
                f.Grid:=FALSE;f.GridType:=TRUE;
                f.KG:=1;f.d:=h.d;
                f.handle:=Handler;
                f.LastModMsg:=TRUE;
                Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
                tf:=TextFrames.NewMenu("", "");
                tf.text:=f.d.MText;
                v:=MenuViewers.New(tf, f, TextFrames.menuH, x, y);
            ELSE
            END;
        END;
    END CopyFrame;
    PROCEDURE MenuFrame(name: ARRAY OF CHAR): TextFrames.Frame;
        VAR
            mf: TextFrames.Frame;
            buf: Texts.Buffer;
            t: Texts.Text;
            r: Texts.Reader;
            end: LONGINT;
            ch: CHAR;
    BEGIN
        IF Files.Old("EditPat.Menu.Text")=NIL THEN
            mf:=TextFrames.NewMenu(name, Menu);
        ELSE
            mf:=TextFrames.NewMenu(name, "");
            NEW(t);Texts.Open(t, "EditPat.Menu.Text");
            Texts.OpenReader(r, t, 0);
            REPEAT
                Texts.Read(r, ch);
            UNTIL r.eot OR (ch=0DX);
            IF r.eot THEN
                end:=t.len;
            ELSE
                end:=Texts.Pos(r)-1;
            END;
            NEW(buf); Texts.OpenBuf(buf);
            Texts.Save(t, 0, end, buf);Texts.Append(mf.text, buf)
        END;
        RETURN mf;
    END MenuFrame;
    (* open new edit frame *)
    PROCEDURE Open*;
        VAR
            x, y: INTEGER;
            f: Frame;
            d: Data;
            v: MenuViewers.Viewer;
            S: Texts.Scanner;
    BEGIN
        NEW(f);IF f=NIL THEN RETURN;END;
        NEW(d);f.d:=d;
        f.Grid:=TRUE;f.GridType:=TRUE;
        d.ActivPat:=NIL;d.LastKilled:=NIL;d.Feld:=NIL;
        f.KG:=20;f.d.Marked:=FALSE;
        d.Color:=Display.white;
        f.handle:=Handler;
        d.Name:="Empty.Pat";
        IF GetPar(S) THEN
            IF S.class=Texts.Name THEN
                COPY(S.s, d.Name);
                LoadPat(d);
            END;
        END;
        f.LastModMsg:=TRUE;
        d.DrawMode:=DrawMode;
        Oberon.AllocateUserViewer(Oberon.Mouse.X, x, y);
        v:=MenuViewers.New(MenuFrame(f.d.Name), f, TextFrames.menuH, x, y);
        f.d.MText:=v.dsc(TextFrames.Frame).text;
    END Open;
BEGIN
    Clip:=NIL;
    F:=Fonts.This("Syntax12.Scn.Fnt");
    Texts.OpenWriter(W);
    Texts.WriteString(W, "EditPat V0.6");
    Texts.WriteLn(W);
    Texts.WriteString(W, "(C) 4 Nov 94 by Ralf Degner");
    Texts.WriteLn(W);
    Texts.Append(Oberon.Log, W.buf);
END EditPat.